home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue67 / Clinic / DragScrollU.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-01-24  |  3.7 KB  |  126 lines
  1. unit DragScrollU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, ComCtrls;
  8.  
  9. type
  10.   TScrollDir = (sdUp, sdLeft, sdDown, sdRight);
  11.   TScrollDirs = set of TScrollDir;
  12.  
  13. type
  14.   TForm1 = class(TForm)
  15.     Memo1: TMemo;
  16.     Label1: TLabel;
  17.     TreeView1: TTreeView;
  18.     Timer1: TTimer;
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure SharedDragOver(Sender, Source: TObject; X, Y: Integer;
  21.       State: TDragState; var Accept: Boolean);
  22.     procedure Timer1Timer(Sender: TObject);
  23.   private
  24.     ScrollDirs: TScrollDirs;
  25.     Ctrl: TWinControl;
  26.   end;
  27.  
  28. var
  29.   Form1: TForm1;
  30.  
  31. implementation
  32.  
  33. {$R *.DFM}
  34.  
  35. uses
  36. {$ifdef Ver90} { Delphi 2.0x }
  37.   OLE2;
  38. {$else}
  39.   ActiveX;
  40. {$endif}
  41.  
  42. procedure TForm1.FormCreate(Sender: TObject);
  43. begin
  44.   TreeView1.FullExpand;
  45. end;
  46.  
  47. procedure TForm1.SharedDragOver(Sender, Source: TObject; X, Y: Integer;
  48.   State: TDragState; var Accept: Boolean);
  49. var
  50.   Style, ExStyle, //Control's windows style and extended window style
  51.   HorzSclHt, VertSclWd, //Scroll bar sizes
  52.   Left, Right, Top, Bottom: Integer;
  53. begin
  54.   Ctrl := Sender as TWinControl;
  55.   case State of
  56.     dsDragEnter,
  57.     dsDragLeave: Timer1.Enabled := False;
  58.     dsDragMove:
  59.     begin
  60.       //Get window styles to see if there are scroll bars/borders
  61.       Style := GetWindowLong(Ctrl.Handle, GWL_STYLE);
  62.       ExStyle := GetWindowLong(Ctrl.Handle, GWL_EXSTYLE);
  63.       //Record scroll bar size, taking into account they might not be there
  64.       HorzSclHt := 0;
  65.       VertSclWd := 0;
  66.       if Style and WS_HSCROLL <> 0 then
  67.         HorzSclHt := GetSystemMetrics(SM_CYHSCROLL);
  68.       if Style and WS_VSCROLL <> 0 then
  69.         VertSclWd := GetSystemMetrics(SM_CXVSCROLL);
  70.       //Record bounding dimensions of control's area,
  71.       //taking into account borders and scroll bars
  72.       Left := 0;
  73.       Top := 0;
  74.       Right := Ctrl.Width - 1 - VertSclWd;
  75.       Bottom := Ctrl.Height - 1 - HorzSclHt;
  76.       if (Style and WS_BORDER <> 0) or (ExStyle and WS_EX_CLIENTEDGE <> 0) then
  77.       begin
  78.         Left := GetSystemMetrics(SM_CXEDGE);
  79.         Top := GetSystemMetrics(SM_CYEDGE);
  80.         Dec(Right, Left);
  81.         Dec(Bottom, Top);
  82.       end;
  83.       //Check if over a scroll bar, in which case reject drop
  84.       if ((X >= Right) and (X <= Right + VertSclWd)) or
  85.          ((Y >= Bottom) and (Y <= Bottom + HorzSclHt)) then
  86.       begin
  87.         Accept := False;
  88.         Exit;
  89.       end;
  90.       //Initialise to no scrolling direction
  91.       ScrollDirs := [];
  92.       //See if in scroll region
  93.       if (X >= Left) and (X < Left + DD_DEFSCROLLINSET) then
  94.         ScrollDirs := ScrollDirs + [sdLeft];
  95.       if (X >= Right - DD_DEFSCROLLINSET) and (X < Right) then
  96.         ScrollDirs := ScrollDirs + [sdRight];
  97.       if (Y >= Top) and (Y < Top + DD_DEFSCROLLINSET) then
  98.         ScrollDirs := ScrollDirs + [sdUp];
  99.       if (Y >= Bottom - DD_DEFSCROLLINSET) and (Y < Bottom)  then
  100.         ScrollDirs := ScrollDirs + [sdDown];
  101.       //If so, reset timer tick and record which region
  102.       if ScrollDirs <> [] then
  103.       begin
  104.         Timer1.Interval := DD_DEFSCROLLDELAY;
  105.         Timer1.Enabled := True;
  106.       end
  107.     end;
  108.   end
  109. end;
  110.  
  111. procedure TForm1.Timer1Timer(Sender: TObject);
  112. begin
  113.   //Depending which region, scroll as appropriate
  114.   if sdLeft in ScrollDirs then
  115.     Ctrl.Perform (WM_HSCROLL, SB_LINELEFT, 0);
  116.   if sdRight in ScrollDirs then
  117.     Ctrl.Perform (WM_HSCROLL, SB_LINERIGHT, 0);
  118.   if sdUp in ScrollDirs then
  119.     Ctrl.Perform (WM_VSCROLL, SB_LINEUP, 0);
  120.   if sdDown in ScrollDirs then
  121.     Ctrl.Perform (WM_VSCROLL, SB_LINEDOWN, 0);
  122.   Timer1.Interval := DD_DEFSCROLLINTERVAL
  123. end;
  124.  
  125. end.
  126.